home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / BARNET / COMPILER / SATHER / !Sather / Library / Containrs / sa / tup < prev   
Text File  |  1996-07-18  |  6KB  |  192 lines
  1. ---------------------------> Sather 1.1 source file <--------------------------
  2. -- Copyright (C) International Computer Science Institute, 1994.  COPYRIGHT  --
  3. -- NOTICE: This code is provided "AS IS" WITHOUT ANY WARRANTY and is subject --
  4. -- to the terms of the SATHER LIBRARY GENERAL PUBLIC LICENSE contained in    --
  5. -- the file "Doc/License" of the Sather distribution.  The license is also   --
  6. -- available from ICSI, 1947 Center St., Suite 600, Berkeley CA 94704, USA.  --
  7. --------> Please email comments to "sather-bugs@icsi.berkeley.edu". <----------
  8.  
  9. -- tup.sa: Tuples
  10. -------------------------------------------------------------------
  11. immutable class TUP{T1} < $HASH, $STR is
  12.    include COMPARABLE;
  13.    include COMPARE{T1};
  14.    attr t1:T1;
  15.    
  16.    create(at1:T1):SAME is return t1(at1) end;
  17.     
  18.    is_eq(e:SAME):BOOL is
  19.       -- True if the component of self and `e' are equal.
  20.       return elt_eq(t1,e.t1);
  21.    end;     
  22.  
  23.    hash:INT is
  24.       -- A simple hash value computed from the hash values of the 
  25.       -- component. For this to work, this must either be a value
  26.       -- type which defines a hash value or a reference type.
  27.       return elt_hash(t1);
  28.    end;
  29.     
  30.    str: STR is 
  31.       res: FSTR := #FSTR("{");
  32.       lt1 ::= t1;
  33.       typecase lt1  when $STR then res := res+lt1.str; else res := res+"_" end;
  34.       res := res+"}";
  35.       return res.str;
  36.    end;
  37.  
  38. end; -- class TUP{T1}
  39.  
  40. -------------------------------------------------------------------
  41. immutable class TUP{T1,T2} < $HASH, $STR is
  42.    include COMPARABLE;
  43.    include COMPARE{T1};
  44.    include COMPARE{T2} elt_eq->elt_eq2,elt_lt->elt_lt2,elt_hash->elt_hash2,
  45.      elt_nil->elt_nil2, is_elt_nil->is_elt_nil2;
  46.    
  47.    attr t1:T1;
  48.    attr t2:T2;
  49.     
  50.    create(at1:T1, at2:T2):SAME is
  51.       return t1(at1).t2(at2) 
  52.    end;      
  53.  
  54.    is_eq(e:SAME):BOOL is
  55.       -- True if the components of self and `e' are equal.
  56.       if ~elt_eq(t1,e.t1) then return false
  57.       elsif ~elt_eq2(t2,e.t2) then return false;
  58.       else return true; end;
  59.    end;     
  60.     
  61.    hash:INT is
  62.       -- A simple hash value computed from the hash values of the 
  63.       -- components. For this to work, these must either be value
  64.       -- types which define hash values or reference types.
  65.       return elt_hash(t1).bxor(elt_hash2(t2).lshift(2)) 
  66.    end;
  67.    
  68.    str: STR is 
  69.       res: FSTR := #FSTR("{");
  70.       lt1 ::= t1;
  71.       typecase lt1  when $STR then res := res+lt1.str; else res := res+"_" end;
  72.       res := res+",";
  73.       lt2 ::= t2;
  74.       typecase lt2  when $STR then res := res+lt2.str; else res := res+"_" end;
  75.       res := res+"}";
  76.       return res.str;
  77.    end;
  78.  
  79.     
  80. end; -- class TUP{T1,T2}
  81. -------------------------------------------------------------------
  82. immutable class TUP{T1,T2,T3} < $HASH, $STR is
  83.    include COMPARABLE;
  84.    private include COMPARE{T1};
  85.    private include COMPARE{T2} elt_eq->elt_eq2,elt_lt->elt_lt2,
  86.      elt_hash->elt_hash2, elt_nil->elt_nil2, is_elt_nil->is_elt_nil2;
  87.    private include COMPARE{T3} elt_eq->elt_eq3,elt_lt->elt_lt3,
  88.      elt_hash->elt_hash3, elt_nil->elt_nil3, is_elt_nil->is_elt_nil3;
  89.    
  90.    attr t1:T1;
  91.    attr t2:T2;
  92.    attr t3:T3;
  93.  
  94.    create(at1:T1, at2:T2, at3:T3):SAME is
  95.       return t1(at1).t2(at2).t3(at3) end;
  96.  
  97.    is_eq(e:SAME):BOOL is
  98.       -- True if the components of self and `e' are equal.
  99.       if ~elt_eq(t1,e.t1) then return false
  100.       elsif ~elt_eq2(t2,e.t2) then return false
  101.       elsif ~elt_eq3(t3,e.t3) then return false
  102.       else return  true end;
  103.    end;
  104.     
  105.    hash:INT is
  106.       -- A simple hash value computed from the hash values of the 
  107.       -- components. For this to work, these must either be value
  108.       -- types which define hash values or reference types.
  109.       
  110.       h1,h2,h3:INT; 
  111.       h1 := elt_hash(t1);
  112.       h2 := elt_hash2(t2);
  113.       h3 := elt_hash3(t3);
  114.       return h1.bxor(h2.lshift(2)).bxor(h3.lshift(4)) 
  115.    end;
  116.     
  117.    str: STR is 
  118.       res: FSTR := #FSTR("{");
  119.       lt1 ::= t1;
  120.       typecase lt1  when $STR then res := res+lt1.str; else res := res+"_" end;
  121.       res := res+",";
  122.       lt2 ::= t2;
  123.       typecase lt2  when $STR then res := res+lt2.str; else res := res+"_" end;
  124.       res := res+",";
  125.       lt3 ::= t3;
  126.       typecase lt3  when $STR then res := res+lt3.str; else res := res+"_" end;
  127.       res := res+"}";
  128.       return res.str;
  129.    end;
  130.    
  131. end; -- class TUP{T1,T2,T3}
  132.  
  133. -------------------------------------------------------------------
  134. immutable class TUP{T1,T2,T3,T4} < $HASH, $STR is
  135.    include COMPARABLE;
  136.    private include COMPARE{T1};
  137.    private include COMPARE{T2} elt_eq->elt_eq2,elt_lt->elt_lt2,
  138.      elt_hash->elt_hash2, elt_nil->elt_nil2, is_elt_nil->is_elt_nil2;
  139.    private include COMPARE{T3} elt_eq->elt_eq3,elt_lt->elt_lt3,
  140.      elt_hash->elt_hash3, elt_nil->elt_nil3, is_elt_nil->is_elt_nil3;
  141.    private include COMPARE{T4} elt_eq->elt_eq4,elt_lt->elt_lt4,
  142.      elt_hash->elt_hash4, elt_nil->elt_nil4, is_elt_nil->is_elt_nil4;
  143.    
  144.    attr t1:T1;
  145.    attr t2:T2;
  146.    attr t3:T3;
  147.    attr t4:T4;
  148.  
  149.    create(at1:T1, at2:T2, at3:T3, at4:T4):SAME is
  150.       return t1(at1).t2(at2).t3(at3).t4(at4) end;
  151.  
  152.    is_eq(e:SAME):BOOL is
  153.       -- True if the components of self and `e' are equal.
  154.       if ~elt_eq(t1,e.t1) then return false
  155.       elsif ~elt_eq2(t2,e.t2) then return false
  156.       elsif ~elt_eq3(t3,e.t3) then return false
  157.       elsif ~elt_eq4(t4,e.t4) then return false
  158.       else return  true end;
  159.    end;
  160.     
  161.    hash:INT is
  162.       -- A simple hash value computed from the hash values of the 
  163.       -- components. For this to work, these must either be value
  164.       -- types which define hash values or reference types.
  165.       h1,h2,h3,h4:INT; 
  166.       h1 := elt_hash(t1);
  167.       h2 := elt_hash2(t2);
  168.       h3 := elt_hash3(t3);
  169.       h4 := elt_hash4(t4);
  170.       return h1.bxor(h2.lshift(2)).bxor(h3.lshift(4)).bxor(h4.lshift(6)) 
  171.    end;
  172.     
  173.    str: STR is 
  174.       res: FSTR := #FSTR("{");
  175.       lt1 ::= t1;
  176.       typecase lt1  when $STR then res := res+lt1.str; else res := res+"_" end;
  177.       res := res+",";
  178.       lt2 ::= t2;
  179.       typecase lt2  when $STR then res := res+lt2.str; else res := res+"_" end;
  180.       res := res+",";
  181.       lt3 ::= t3;
  182.       typecase lt3  when $STR then res := res+lt3.str; else res := res+"_" end;
  183.       res := res+",";
  184.       lt4 ::= t4;
  185.       typecase lt4  when $STR then res := res+lt4.str; else res := res+"_" end;
  186.       res := res+"}";
  187.       return res.str;
  188.    end;
  189.    
  190. end; -- class TUP{T1,T2,T3,T4}
  191. -------------------------------------------------------------------
  192.